{$S+}
unit SCREENOPS;         {A restricted implementation of version IV's SCREENOPS.}
  
  {Al Hayden Aug 1981.  Last changed Austin Tate 19-Jan-82}
  
  {Apple version which picks up the syscom variables.  For version II.1}
  
  { This is defined for version IV on pages 127..131 of the UCSD architecture
    guide. If you have a version IV system, it should be used. This unit is
    intended for use by version II users who will upgrade later, to allow them
    to write compatable software.
    If you want to play with this lot or modify it, the source (it's very 
    simple) is available from ERCC Micro Support Unit.                         }
    
    
  interface
    
    type
      SC_Long_String = string[255];           {used to pass prompt-lines around}
      SC_ChSet       = set of char;        {holds a list of chars to match with}
    
    var SC_f:file;  {unfortunately has to be public - so different user interface}
    
    procedure SC_Clr_Line (Y :integer);
                        {Clears line number Y within the current text port.}
    
    procedure SC_Clr_Screen;
                        {Clears the screen.}
    
    procedure SC_Erase_to_EOL (X, Line :integer);
                        {Starting at position (X, Line) within the current text
                         port, everything to the end of the line is erased.}
    
    function  Space_Wait (Flush :boolean) :boolean;
                        {This repeatedly reads from the keyboard until a
                         <space> or the ESC character is recieved.
                         Before doing this it does a UNITCLEAR to 1 and 2
                         if Flush is true, and writes 'Type <space> to
                         continue'. It returns true if a <space> was not
                         read. Note: ESC replaces the ALTMODE character.    }
    
    function  SC_Prompt (Line :SC_Long_String;
                         X_Cursor, Y_Cursor, X_Pos, Where :integer;
                         Return_on_Match :SC_ChSet;
                         No_Char_Back :boolean;
                         Break_Char :char) :char;
                        {This function displays the prompt-line, Line, in the
                         current text-port at (X_pos, Where). The cursor is
                         placed at (X_Cursor, Y_Cursor) after the prompt is
                         printed. If X_Cursor is less than 0, the cursor is
                         placed at the end of the prompt. If a character is
                         being prompted for, No_Char_Back should be sent as
                         false. The keyboard is repeatedly read until the
                         character matches one within Return_on_Match.}
                                  
  implementation

    CONST NUL=0;
    
    TYPE CRTCommand=(ErasEOS,ErasEOL,LeadIn);
    
    VAR CRTInfo:  packed array [CRTCommand] of Char;
        Prefixed: array [CRTCommand] of Boolean;
    
    procedure GetCRTInfo;
    var buffer: packed array [0..511] of char;
        i,j,byte: integer;
    begin
      {$I-}
      Reset(SC_f,'*SYSTEM.MISCINFO');
      i:=IORESULT;
      j:=BLOCKREAD(SC_f,buffer,1);
      if (IORESULT<>0) or (i<>0) or (j<>1) then
        WRITELN('*SYSTEM.MISCINFO must be available.');
      close(SC_f);
      {$I+}
      {the following values got from APPLE3:DISKIO.TEXT}
      {in that there are also values for UP,DOWN,LEFT and RIGHT}
      byte:=ord(buffer[72]); {prefix info byte}
      CRTInfo[LeadIn ]:=buffer[62]; Prefixed[LeadIn ]:=FALSE;
      CRTInfo[ErasEOS]:=buffer[64]; Prefixed[ErasEOS]:=ODD(Byte DIV 8);
      CRTInfo[ErasEOL]:=buffer[65]; Prefixed[ErasEOL]:=ODD(Byte DIV 4);
    end;
    
    procedure CRT(C:CRTCommand);
    var nul:packed array [0..1] of char;
    begin
      if prefixed[C] then unitwrite(1,CRTInfo[LeadIn],1,0,12);
      unitwrite(1,CRTInfo[C],1,0,12);
      nul[0]:=chr(0);
      nul[1]:=chr(0);
      unitwrite(1,nul,2,0,12);
      {at least 2 fillers to allow for gotoxy using nuls}
    end;
    
    procedure SC_Clr_Line {Y :integer};
    begin
      gotoXY (0, Y);
      if CrtInfo[ErasEOL]=CHR(NUL) then
        begin
          write (' ':79);
          gotoXY (0, Y);
        end
      else CRT(ErasEOL);
    end; {of SC_Clr_Line}
    
    procedure SC_Clr_Screen;
    var COUNT :integer;
    begin
      if CrtInfo[ErasEOS]=CHR(NUL) then
        begin
          gotoXY (0, 23);                 { Slow but safe bit for screens    }
          for COUNT := 1 to 24 do writeln;{ which don't recognise form-feeds }
          gotoXY (0, 0);
        end
      else
        begin
          gotoXY(0,0);
          CRT(ErasEOS);
        end;
    end; {of SC_Clr_Screen}
    
    procedure SC_Erase_to_EOL {X, Line :integer};
    begin
      gotoXY (X, Line);
      if CrtInfo[ErasEOL]=CHR(NUL) then
        begin
          write (' ':(80 - X));
          gotoXY (X, Line);
        end
      else CRT(ErasEOL);
    end; {of SC_Erase_to_EOL}
    
    function  Space_Wait {Flush :boolean} {:boolean};
    const ESC = 27;
    var   CH :char;
    begin
      if Flush then
        begin
          unitclear (1);
          unitclear (2);
        end;
      write ('Type <space> to continue');
      repeat read (KEYBOARD, CH) until (CH = ' ') or (CH = chr (ESC));
      if CH = ' ' then
        Space_Wait := false
      else
        Space_Wait := true;
    end;
    
    function  SC_Prompt {Line :SC_long_String;.....; Break_Char :char}{ :char};
    const BS  = 8;                                                  {back-space}
          BEL = 7;                                                        {bell}
    var   CH  :char;                                         {command character}
    begin
      if No_Char_Back then                               {no command to be read}
        CH := chr (0)                                          {so nothing sent}
      else
        begin
          SC_Clr_Line (Where); write (LINE);                {put up prompt line}
          if X_Cursor >= 0 then gotoXY (X_Cursor, Y_Cursor);      {place cursor}
          repeat
            read (KEYBOARD, CH);                     {read character, invisibly}
            if CH in ['a'..'z'] then CH := chr (ord (CH) - 32);     {upper case}
            if CH >= ' ' then                    {if it's a printable character}
              begin
                write (CH); write (chr (BS));   {echo character, then sit on it}
              end
            else
              write (chr (BEL));                   {illegal character, so bleep}
          until CH in Return_on_Match;
        end;
        SC_Prompt := CH;                          {valid character now returned}
     end; {of SC_Prompt}
     
begin
  GetCRTInfo; {initialise SYSCOM variables}
end. {of unit SCREENOPS}
